home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format CD 49
/
Amiga Format CD49 (2000-01-17)(Future Publishing)(GB)(Track 1 of 3)[!][issue 2000-02].iso
/
-coverdisks-
/
133a
/
palettedeck
/
palettedeck.z
< prev
next >
Wrap
Text File
|
1999-12-01
|
15KB
|
631 lines
Deck "PaletteDeck"
Routine "Quit"
Do "Get_TOOLTYPES"
Let X=WindowX,Y=WindowY,W=WindowWidth,H=WindowHeight
If X<>WinX
Let CP=True
EndIf
If Y<>WinY
Let CP=True
EndIf
If W<>WinW
Let CP=True
EndIf
If H<>WinH
Let CP=True
EndIf
If CP=True
Do "SaveIcon"
EndIf
Quit
EndScript
Routine "Get_GFX.PREFS"
WorkWithDocument "TEMP"
Clear DOCUMENT
InsertMessagePortList
MoveCursorTo STARTOF DOCUMENT
SplitLine
MoveCursorTo STARTOF DOCUMENT
SearchFor "CYBERGRAPHICS.LIBRARY",BYWORD NOCASE
If SearchFound
Let CYBERGFX=TRUE,DBLHEIGHT=TRUE,DBLWIDTH=TRUE
Else
Let CYBERGFX=FALSE
EndIf
EndScript
Routine "IN_Case.WinX"
Let WinX=Limit(0,ScreenWidth,Arg1)
EndScript
Routine "IN_Case.WinY"
Let WinY=Limit(0,ScreenHeight,Arg1)
EndScript
Routine "IN_Case.WinH"
Let WinH=Limit(177,ScreenHeight,Arg1)
EndScript
Routine "IN_Case.WinW"
Let WinW=Limit(376,ScreenWidth,Arg1)
EndScript
Routine "GetColors"
Let I=0
Loop
GetRGB I,R[I],G[I],B[I]
Let I=I+1
Until I>MaxColor
EndScript
Routine "ResetColors"
Let I=0
Loop
SetRGB I,R[I],G[I],B[I]
Let I=I+1
Until I>MaxColor
Do "SetProps"
EndScript
Routine "Box"
Let Row=PenA%8
Let Column=PenA//8
Let Top=StartY+Row*IncY-1
Let Left=StartX+Column*IncX-1
Let APen=PenA
SetPen Arg1
DrawBorder Left,Top+1,IncX,IncY-1,BEVEL ,Arg1,2
DrawBorder Left+3,Top+3,IncX-6,IncY-5,OUTLINE ,0,0
SetPen APen
EndScript
Routine "SetProps"
Let APen=PenA
SetPen 1
GetRGB APen,Red,Green,Blue
Do "PrintPropPos"
SetPropPosition "Prop_R",Red
SetPropPosition "Prop_G",Green
SetPropPosition "Prop_B",Blue
SetPen APen
EndScript
Routine "PropRelease"
Let APen=PenA
SetPen 1
Do "PrintPropPos"
SetPen APen
Let PendingCommand="None"
EndScript
Routine "Get_FONT.PREFS"
Local READFILE="ENV:sys/font.prefs",X=0,SizeVar="",FontVar=""
If EXISTS(READFILE)=TRUE
IfError
Let SysDefText="topaz",SysDefTextSize=8
Else
If FileSize(READFILE)>""
GetFileInfo READFILE,FILECNT
SetFileBufferSize Limit(1,1024,Integer(FILECNT%1024))
OpenFile READFILE,"WORKFILE",READONLY ,OLDFILE
FileReadChars "WORKFILE",X,223
FileReadChars "WORKFILE",SizeVar,1,HEX
FileReadChars "WORKFILE",X,2
FileReadChars "WORKFILE",FontVar,30
Let SysDefTextSize=HexToInteger(SizeVar)
Let SysDefText=GetWord(FontVar,1,".")
Close "WORKFILE"
Else
Let SysDefText="topaz",SysDefTextSize=8
EndIf
EndIf
Else
Let SysDefText="topaz",SysDefTextSize=8
EndIf
GetFontInfo SCREEN ,ScreenText,ScreenTextSize
Let GOS=ScreenTextSize+3
EndScript
Routine "DrawPalette"
Let MaxColor=WindowColors-1
Let NumRows=WindowColors%8
If NumRows=0
Let NumRows=1
Let NumCols=WindowColors
Else
Let NumCols=8
EndIf
Let StartX=11
Let StartY=34
Let IncX=(WinW-111)/NumCols
Let IncY=(WinH-110)/NumRows
Let I=0
Let J=0
Let X=0
Let Y=0
Loop
Loop
SetPen I+J*NumCols
AreaRectangle StartX+X,StartY+Y,IncX-1,IncY-1
Let I=I+1
Let X=X+IncX
Until I=NumCols
Let I=0
Let J=J+1
Let X=0
Let Y=Y+IncY
Until J=NumRows
EndScript
Routine "SaveVar"
Let PalData.WinX=WinX
Let PalData.WinY=WinY
Let PalData.WinW=WinW
Let PalData.WinH=WinH
SaveVariable PalData,"Ram:Pal.Data"
EndScript
Routine "LoadVar"
If Exists("Ram:Pal.Data")
Let PalData=LoadVariable("Ram:Pal.Data")
IfError
Let WinX=0,WinY=GOS,WinW=376,WinH=169+SCREENTEXTSIZE
Else
Let WinX=PalData.WinX,WinY=PalData.WinY,WinW=PalData.WinW,WinH=PalData.WinH
EndIf
ElseIf Exists(TheCurrentDirectory||"Pal.Data")
Let PalData=LoadVariable(TheCurrentDirectory||"Pal.Data")
IfError
Let WinX=0,WinY=GOS,WinW=376,WinH=169+SCREENTEXTSIZE
Else
Let WinX=PalData.WinX,WinY=PalData.WinY,WinW=PalData.WinW,WinH=PalData.WinH
EndIf
Else
Do "SaveVar"
EndIf
EndScript
Routine "Get_TOOLTYPES"
WorkWithDocument "ToolTypes"
Clear DOCUMENT
If Exists(DECKNAME||".info")
LoadIcon DECKNAME,"ICON"
IfError
Do "LoadVar"
Else
WorkWithDocument "ToolTypes"
Clear DOCUMENT
InsertToolTypeList "ICON"
MoveCursorTo STARTOF DOCUMENT
If LINESINDOCUMENT>=2
Loop
If NOT Match(GetChars(THELINE,1,1),"(","[","{","<","«",";")
Do "IN_Case."||UpperCase(GetWord(THELINE,1,"=")),UpperCase(GetWord(THELINE,1,"WwIiNnHhXxYy = "))
IfError
EndIf
EndIf
MoveCursor DOWN
Until THELINENUMBER=LINESINDOCUMENT
EndIf
Flush "ICON"
EndIf
Else
Do "LoadVar"
EndIf
EndScript
Routine "SearchFor"
WorkWithDocument "ToolTypes"
MoveCursorTo STARTOF DOCUMENT
SearchFor Arg1,NOCASE
If SearchFound
Let Word=GetWord(TheLine,1)
If Word<>Arg1||Arg2
If Match(GetChars(Word,1,1),"(","[","{","<","«",";")
MoveCursorTo ENDOF DOCUMENT
Else
Delete LINE
EndIf
MoveCursorTo ENDOF DOCUMENT
Type Arg1||Arg2,NEWLINE
EndIf
Else
MoveCursorTo ENDOF DOCUMENT
Type Arg1||Arg2,NEWLINE
EndIf
EndScript
Routine "SaveIcon"
Do "Get_TOOLTYPES"
WorkWithDocument "ToolTypes"
MoveCursorTo STARTOF DOCUMENT
Let WinX=WindowX,WinY=WindowY,WinW=WindowWidth,WinH=WindowHeight
Do "SearchFor","WinX=",WinX
Do "SearchFor","WinY=",WinY
Do "SearchFor","WinW=",WinW
Do "SearchFor","WinH=",WinH
SetToolTypeList DeckName,"ToolTypes"
SaveIcon DeckName,DeckName
EndScript
Routine "DrawWin"
SetDrawMode JAM2
Let WinW=WindowWidth
Let WinH=WindowHeight
Do "DrawPalette"
DrawBorder WinW-94,16+AY1,72,WinH-(90+AY1),BEVEL ,1,2
SetPrintFont "topaz",8
SetPen 1,0
PrintText "R",8,WinH-68
PrintText "G",8,WinH-52
PrintText "B",8,WinH-36
SetPen 0
Do "Box",1
Do "SetProps"
Do "GetColors"
Let PendingCommand="None"
EndScript
Routine "PrintPropPos"
SetDrawMode JAM2
PrintText FormatValue(Red,"000"),WinW-43,WinH-(51+AY1)
PrintText FormatValue(Green,"000"),WinW-43,WinH-(37+AY1)
PrintText FormatValue(Blue,"000"),WinW-43,WinH-(21+AY1)
EndScript
Routine "ClickColor"
Do "Box",0
Do "DrawPalette"
Let CurX=MouseX
Let CurY=MouseY
Let CurRow=Min((CurY-StartY)%IncY+1,NumRows)
Let CurCol=Min((CurX-StartX)%IncX+1,NumCols)
Let PenNum=8*(CurRow-1)+(CurCol-1)
GetRGB PenA,Red,Green,Blue
If PendingCommand="Copy"
SetRGB PenNum,Red,Green,Blue
ElseIf PendingCommand="Exchange"
GetRGB PenNum,Red2,Green2,Blue2
SetRGB PenA,Red2,Green2,Blue2
SetRGB PenNum,Red,Green,Blue
ElseIf PendingCommand="Spread"
Let PenDiff=Absolute(PenNum-PenA)
If PenDiff>1
Let StartPen=Min(PenA,PenNum)
If StartPen=PenA
GetRGB PenA,Red,Green,Blue
GetRGB PenNum,Red2,Green2,Blue2
Else
GetRGB PenNum,Red,Green,Blue
GetRGB PenA,Red2,Green2,Blue2
EndIf
Let RedInc=(Red2-Red)/PenDiff
Let GreenInc=(Green2-Green)/PenDiff
Let BlueInc=(Blue2-Blue)/PenDiff
Let CurPen=StartPen+1
While CurPen<=StartPen+PenDiff-1
Let NewRed=Red+(CurPen-StartPen)*RedInc
Let NewGreen=Green+(CurPen-StartPen)*GreenInc
Let NewBlue=Blue+(CurPen-StartPen)*BlueInc
SetRGB CurPen,NewRed,NewGreen,NewBlue
Let CurPen=CurPen+1
EndLoop
EndIf
EndIf
SetPen PenNum
Let PendingCommand="None"
AreaRectangle WinW-90,18+AY1,64,WinH-(95+AY1)
Do "SetProps"
Do "Box",1
EndScript
Resource "PROGRAM"
BeforeAttachment
SetAutoFileRequester FALSE
Do "Get_GFX.PREFS"
Do "Get_FONT.PREFS"
Let WinX=0,WinY=GOS,WinW=376,WinH=169+SCREENTEXTSIZE
If THEPUBSCREENTITLE=""
Let THEPUBSCREENTITLE="Workbench"
Else
Let THEPUBSCREENTITLE=Name
EndIf
Do "Get_TOOLTYPES"
EndScript
AfterAttachment
SetAutoFileRequester FALSE
SetSystemRequesterTo WINDOW
Let WinBorT=WINDOWBORDERTOP
Let DBLHEIGHT=IfThen(CYBERGFX=TRUE,TRUE,Interlace)
Let DBLWIDTH=IfThen(CYBERGFX=TRUE,TRUE,Hires)
Let Horiz=IfThen(DBLWIDTH=TRUE,8,4)
Let Vert=IfThen(DBLHEIGHT=TRUE,4,4)
Let AX1=Horiz+1
Let AY1=WinBorT+Vert
AttachObject "OBJECTS"
Do "DrawWin"
EndScript
Window "MainWindow"
Definition
Origin WinX,WinY
Title "Palette Deck..."
WindowObjects CLOSEBUTTON DEPTHBUTTONS DRAGBAR SIZEBUTTON
WindowLimits 376,169,ScreenWidth,ScreenHeight
WindowZoom -1,-1,376,169
Size WinW,WinH
WindowFlags ACTIVATE TOFRONT PUBLIC ,THEPUBSCREENTITLE
VisualEffects NONE ,NONE
EndScript
OnCloseButton
Do "Quit"
EndScript
OnResized
If ObjectAttached("OBJECTS")
DetachObject "OBJECTS"
ClearWindow
AttachObject "OBJECTS"
EndIf
Do "DrawWin"
EndScript
EndObj
Resource "OBJECTS"
NoAttach
BeforeAttachment
Let WinW=WindowWidth
Let WinH=WindowHeight
EndScript
AreaButton "B_Copy"
Definition
Origin AX1,AY1
Border BEVEL ,2,4
Text "Copy"
Font "topaz",8
Size 64,13
EndScript
OnRelease
Let PendingCommand="Copy"
EndScript
AfterAttachment
DrawBorder AX1,AY1,64,13,OUTLINE ,1,1
EndScript
EndObj
AreaButton "B_Swap"
Definition
Origin Whole(79+((WinW-376)/2)/2),AY1
Border BEVEL ,2,4
Text "Swap"
Font "topaz",8
Size 64,13
EndScript
OnRelease
Let PendingCommand="Exchange"
EndScript
AfterAttachment
DrawBorder Whole(79+((WinW-376)/2)/2),AY1,64,13,OUTLINE ,1,1
EndScript
EndObj
AreaButton "B_Spread"
Definition
Origin Whole(149+((WinW-376)/2)),AY1
Border BEVEL ,2,4
Text "Spread"
Font "topaz",8
Size 64,13
EndScript
OnRelease
Let PendingCommand="Spread"
EndScript
AfterAttachment
DrawBorder Whole(149+((WinW-376)/2)),AY1,64,13,OUTLINE ,1,1
EndScript
EndObj
AreaButton "B_Screens"
Definition
Origin Whole(219+((WinW-376)/2)*5/3),AY1
Border BEVEL ,2,4
Text "Screens"
Font "topaz",8
Size 64,13
EndScript
OnRelease
If Not ObjectAttached("Pub")
AttachObject "Pub"
EndIf
WorkWithDocument "PubScreens"
Clear DOCUMENT
InsertPubScreenList
Delete CHARACTER ,-1
MoveCursorTo STARTOF DOCUMENT
EndScript
AfterAttachment
DrawBorder Whole(219+((WinW-376)/2)*5/3),AY1,64,13,OUTLINE ,1,1
EndScript
EndObj
AreaButton "B_Restore"
Definition
Origin WinW-87,AY1
Border BEVEL ,2,4
Text "Restore"
Font "topaz",8
Size 64,13
EndScript
OnRelease
Do "ResetColors"
Let PendingCommand="None"
EndScript
AfterAttachment
DrawBorder WinW-87,AY1,64,13,OUTLINE ,1,1
EndScript
EndObj
AreaButton "B_AreaPal"
Definition
Origin 8,16+AY1
Border BEVEL
Highlight NONE
Size WinW-106,WinH-(90+AY1)
EndScript
OnClick
Do "ClickColor"
EndScript
EndObj
AreaButton "B_Save"
Definition
Origin AX1,WinH-(5+AY1)
Border BEVEL ,2,4
Text "Save"
Font "topaz",8
Size 58,13
EndScript
OnRelease
ClipBrush 21,42,28,11,"PalBrush"
SaveBrush "PalBrush",TheCurrentDirectory||"Pal.Prefs"
EndScript
AfterAttachment
DrawBorder AX1,WinH-(5+AY1),58,13,OUTLINE ,1,1
EndScript
EndObj
AreaButton "B_Use"
Definition
Origin Whole(152+((WinW-376)/2)),WinH-(5+AY1)
Border BEVEL ,2,4
Text "Use"
Font "topaz",8
Size 58,13
EndScript
OnRelease
Do "Quit"
EndScript
AfterAttachment
DrawBorder Whole(152+((WinW-376)/2)),WinH-(5+AY1),58,13,OUTLINE ,1,1
EndScript
EndObj
AreaButton "B_Cancel"
Definition
Origin WinW-81,WinH-(5+AY1)
Border BEVEL ,2,4
Text "Cancel"
Font "topaz",8
Size 58,13
EndScript
OnRelease
Do "ResetColors"
Do "Quit"
EndScript
AfterAttachment
DrawBorder WinW-81,WinH-(5+AY1),58,13,OUTLINE ,1,1
EndScript
EndObj
AreaProp "Prop_R"
Definition
Origin 27,WinH-(53+AY1)
Size WinW-74,9
MoveType HORIZONTAL
Range 0,255,1,10
VisibleRange 1,1
InitialPosition 1,1
PropBorder No
Image "Prop-a.br"
AltImage "Prop-b.br"
EndScript
OnNewPosition
GetPropPosition "Prop_R",NewPos
GetRGB PenA,Red,Green,Blue
SetRGB PenA,NewPos,Green,Blue
Do "PrintPropPos"
EndScript
OnRelease
Do "PropRelease"
EndScript
AfterAttachment
DrawBorder 26,WinH-(54+AY1),WinW-74,11,DOUBLEBEVEL ,2,1
EndScript
EndObj
AreaProp "Prop_G"
Definition
Origin 27,WinH-(36+AY1)
Size WinW-74,9
MoveType HORIZONTAL
Range 0,255,1,10
VisibleRange 1,1
InitialPosition 1,1
PropBorder No
Image "Prop-a.br"
AltImage "Prop-b.br"
EndScript
OnNewPosition
GetPropPosition "Prop_G",NewPos
GetRGB PenA,Red,Green,Blue
SetRGB PenA,Red,NewPos,Blue
Do "PrintPropPos"
EndScript
OnRelease
Do "PropRelease"
EndScript
AfterAttachment
DrawBorder 26,WinH-(37+AY1),WinW-74,11,DOUBLEBEVEL ,2,1
EndScript
EndObj
AreaProp "Prop_B"
Definition
Origin 27,WinH-(19+AY1)
Size WinW-74,9
MoveType HORIZONTAL
Range 0,255,1,10
VisibleRange 1,1
InitialPosition 1,1
PropBorder No
Image "Prop-a.br"
AltImage "Prop-b.br"
EndScript
OnNewPosition
GetPropPosition "Prop_B",NewPos
GetRGB PenA,Red,Green,Blue
SetRGB PenA,Red,Green,NewPos
Do "PrintPropPos"
EndScript
OnRelease
Do "PropRelease"
EndScript
AfterAttachment
DrawBorder 26,WinH-(20+AY1),WinW-74,11,DOUBLEBEVEL ,2,1
EndScript
EndObj
TextMenu "Load"
Definition
AttachTo MENU ,"Project..."
Text "Load..."
ShortCutKey "L"
EndScript
Occurred
SetFileRequestMode REGULARMODE ,REJECTICONS PATTERNFIELD
SetFileRequestPattern "#?.Prefs"
Let FileName=AskForFileName(TheCurrentDirectory||".Prefs","Select Palette To Load...")
If FileOf(FileName)<>Nothing
ShowPalette FileName
EndIf
EndScript
EndObj
TextMenu "About"
Definition
AttachTo MENU ,"Project..."
Text "About..."
EndScript
Occurred
WorkWithDocument "TEMP"
Clear DOCUMENT
Type "Palette Deck Version 0.9",NEWLINE
Type "By Thomas R. Grant",NEWLINE
Type "tgrant@merlin.net.au",NEWLINE
Type "http://arthur.merlin.net.au/~tgrant/",NEWLINE
Local ©=AskForResponse(TextFromDocument("TEMP"),"about Palette Deck")
EndScript
EndObj
Resource "Pub"
NoAttach
Memo "Screens"
Definition
MemoDocument "PubScreens"
ScrollBars RIGHT
InputStyle LOCKEDOUT
Origin 10,WinH-(55+AY1)
Size WinW-34,47
Border INVERT BEVEL
Font "topaz",8
EndScript
OnRelease
WorkWithDocument "PubScreens"
Let Name=GetWord(TheLine,1)
If PubScreenExists(Name)
Let THEPUBSCREENTITLE=Name
If ObjectAttached("OBJECTS")
DetachObject "PROGRAM"
AttachObject "PROGRAM"
EndIf
EndIf
EndScript
EndObj
EndObj
EndObj
EndObj
EndObj